MacFormat 1995 May/macformat-024.iso/Shareware City/Developers/TransSkel Pascal 2.5/TransSkel/NewStuff ƒ/NewStuff.p

Text File | 1995-01-02 | 8.8 KB | 374 lines | [TEXT/PJMM]

{NewStuff by Ingemar Ragnemalm}
{}
{This is an extra demo that I have made for TransSkel, in order to demonstrate some of the}
{new features.}
{}
{Some features are yet not demonstrated, namely how to handle Apple Events and how to use}
{the mouse region in WaitNextEvent.}

program NewStuff;

    uses
{$IFC UNDEFINED THINK_PASCAL}
        Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf, GestaltEqu,
{$ENDC}
        Picker, DialogUtils, TransSkel;

    const
        kFileMenuRes = 128;        {MENU resource id}
        kHierMenuRes = 129;    {MENU resource id}
        kDlogRes = 128;            {DLOG resource id}
        kAboutRes = 129;        {ALRT resource id}
        kMessageRes = 130;        {ALRT resource id}

    var
        fileMenu, hierMenu: MenuHandle;
        theDialog: DialogPtr;
        theColor: RGBColor;
        gR: Rect; {Used for a silly nullEvent animation}
        gColorFlag: Boolean;
        gMouseRgn1, gMouseRgn2, gMouseRgn3: RgnHandle;

{Dialog items}
    var
        defaultItem: integer; {Either changeButton or beepButton}
    const
{1: Stat text}
        userItem = 2;
        changeButton = 3;
        beepButton = 4;
        changeRadio = 5;
        beepRadio = 6;
{7: Stat text}
        editText = 8;


{Respond to selection of "About"}
    procedure DoAbout;
    begin
        if Alert(kAboutRes, nil) = 1 then
            ;
    end;

    procedure DoFileMenu (item: integer);
    begin
        case item of
            1:
                if 1 = Alert(kMessageRes, nil) then
                    ;
{2 is the hierarcical item, which works automatically}
            4:
                SkelWhoa;
            otherwise
                SkelWhoa;
        end{case}
    end;

    procedure DoHierMenu (item: integer);
        var
            savePort: GrafPtr;
    begin
        case item of
            1:
                begin
                    theColor.red := -1;
                    theColor.green := 0;
                    theColor.blue := 0;
                end;
            2:
                begin
                    theColor.red := 0;
                    theColor.green := -1;
                    theColor.blue := 0;
                end;
            3:
                begin
                    theColor.red := 0;
                    theColor.green := 0;
                    theColor.blue := -1;
                end;
        end; {case}

{Force an update on the user item rectngle}
        GetPort(savePort);
        SetPort(theDialog);
        InvalRect(GetDItemBox(theDialog, userItem));
        SetPort(savePort);
    end;

{    Initialize menus.  Tell TransSkel to process the Apple menu}
{    automatically, and associate the proper procedures with the}
{    File and Edit menus.}

    procedure SetUpMenus;
    begin
        SkelApple('About NewStuff…', @DoAbout);
        fileMenu := GetMenu(kFileMenuRes);
        if SkelMenu(fileMenu, @DoFileMenu, nil, true) then
            ;                                        {Tell TransSkel to handle the menu}
        hierMenu := GetMenu(kHierMenuRes);
        if SkelHMenu(hierMenu, @DoHierMenu, nil) then
            ;                                        {Tell TransSkel to handle the hierarcical menu}
    end;

{Routines for the modeless dialog window}

    procedure DoChange;
        var
            savePort: GrafPtr;
    begin
        if gColorFlag then
            begin
                if GetColor(Point($00400040), 'Select a new color', theColor, theColor) then
                    begin
{Force an update on the user item rectngle}
                        GetPort(savePort);
                        SetPort(theDialog);
                        InvalRect(GetDItemBox(theDialog, userItem));
                        SetPort(savePort);
                    end;
            end
        else
            SysBeep(1);
    end;

    procedure DoEnter;
        var
            l: Longint;
    begin
        HighlightDItem(theDialog, defaultItem);
        Delay(2, l);
        EnableDItem(theDialog, defaultItem);    {Un-highlight}
        if defaultItem = changeButton then
            begin
                DoChange;
            end
        else if defaultItem = beepButton then
            begin
                SysBeep(1);
            end;
    end;

{Handle events in the dialog. We only bother with keydown events here.}

    procedure Event (itemNum: integer; theEvent: EventRecord);
        var
            box, r1, r2: Rect;
    begin
        if theEvent.what = mouseDown then
            case itemNum of
                changeButton:
                    DoChange;
                beepButton:
                    SysBeep(1);
                changeRadio:
                    begin
                        SetBooleanDItem(theDialog, changeRadio, true);
                        SetBooleanDItem(theDialog, beepRadio, false);
                        defaultItem := changeButton;
                        r1 := GetDItemBox(theDialog, changeButton);
                        r2 := GetDItemBox(theDialog, beepButton);
                        UnionRect(r1, r2, r1);
                        InsetRect(r1, -4, -4);
                        InvalRect(r1);
                    end;
                beepRadio:
                    begin
                        SetBooleanDItem(theDialog, changeRadio, false);
                        SetBooleanDItem(theDialog, beepRadio, true);
                        defaultItem := beepButton;
                        r1 := GetDItemBox(theDialog, changeButton);
                        r2 := GetDItemBox(theDialog, beepButton);
                        UnionRect(r1, r2, r1);
                        InsetRect(r1, -4, -4);
                        InvalRect(r1);
                    end;
                otherwise
            end; {case}

    end; {Event}

    procedure Filter (theDialog: DialogPtr; var theEvent: EventRecord; var result: Boolean);
        var
            theKey: Char;
            box: Rect;
            saveColor: RGBColor;
    begin
        result := false;

{If we want to filter out crtain events, we can do it here. In our case, we filter out}
{return and enter, which now activates the default button rather than sending them}
{to the edit box.}

        if (theEvent.what = keyDown) or (theEvent.what = autoKey) then
            begin
                theKey := char(BitAnd(theEvent.message, charCodeMask));
                if (ord(theKey) = 13) or (ord(theKey) = 3) then
                    begin
{Filter out the keydown so it won't go into the edit box.}
                        DoEnter;
                        result := true;
                    end;
            end;

{If we have special items - in this case a user item and a frame around a button - we}
{must handle the update event in the filter function. If we don't, DialogSelect will handle}
{it for us, inside TransSkel, and just update all standard items.}

        if theEvent.what = updateEvt then
            if theDialog = WindowPtr(theEvent.message) then
                begin
                    BeginUpdate(theDialog);
                    SetPort(theDialog);
                    EraseRect(theDialog^.portRect);

                    DrawDialog(theDialog);

                    box := GetDItemBox(theDialog, defaultItem);
                    InsetRect(box, -4, -4);
                    PenSize(3, 3);
                    FrameRoundRect(box, 15, 15);

                    box := GetDItemBox(theDialog, userItem);
                    if gColorFlag then
                        begin
                            GetForeColor(saveColor);
                            RGBForeColor(theColor);
                            PaintRect(box);
                            RGBForeColor(saveColor);
                        end;

                    EndUpdate(theDialog);
                    result := true;
                end;

    end; {Filter}


    procedure CalcRegions;
        var
            p: Point;
    begin
{We need three regions:}
{1) the editable text box}
{2) the window except the edit text}
{3) everything else}

        gMouseRgn1 := NewRgn;
        gMouseRgn2 := NewRgn;
        gMouseRgn3 := NewRgn;
        RectRgn(gMouseRgn1, GetDItemBox(theDialog, editText));
        RectRgn(gMouseRgn2, theDialog^.portRect);
        SetPt(p, 0, 0);
        LocalToGlobal(p);
        OffsetRgn(gMouseRgn1, p.h, p.v);
        OffsetRgn(gMouseRgn2, p.h, p.v);
        CopyRgn(GetGrayRgn, gMouseRgn3);
        DiffRgn(gMouseRgn3, gMouseRgn2, gMouseRgn3);
        DiffRgn(gMouseRgn2, gMouseRgn1, gMouseRgn2);
        SkelSetMouseRgn(gMouseRgn1);
    end;

    procedure SetupDialog;
    begin
        theDialog := GetNewDialog(kDlogRes, nil, WindowPtr(-1));
        if SkelDialog(theDialog, @Event, nil, nil, @Filter) then
            ;

        gMouseRgn1 := NewRgn;
        gMouseRgn2 := NewRgn;
        gMouseRgn3 := NewRgn;
        CalcRegions;

{Indicate the default button and set its radio button}
        defaultItem := changeButton;
        SetBooleanDItem(theDialog, changeRadio, true);

{Set up the little rectangle used for indicating that there is a background process}
        gR := theDialog^.portRect;
        gR.left := gR.right - 5;
        gR.bottom := gR.top + 5;
    end;

{MultiFinder events}

    procedure DoSuspendResume (isResume: Boolean);
    begin
        if isResume then
            SkelSetSleep(2) {Resume}
        else
            SkelSetSleep(20); {Suspend}
    end;

    procedure DoMouseMoved;
        var
            p: Point;
    begin
        GetMouse(p);
        LocalToGlobal(p);
        CalcRegions;
        if PtInRgn(p, gMouseRgn1) then
            begin
                SkelSetMouseRgn(gMouseRgn1);
                SetCursor(GetCursor(1)^^); {I-beam cursor, for text}
            end
        else if PtInRgn(p, gMouseRgn2) then
            begin
                SkelSetMouseRgn(gMouseRgn2);
                SetCursor(GetCursor(128)^^); {Upside-down cursor}
            end
        else if PtInRgn(p, gMouseRgn3) then
            begin
                SkelSetMouseRgn(gMouseRgn3);
{$IFC UNDEFINED THINK_PASCAL}
                SetCursor(qd.arrow);
{$ELSEC}
                SetCursor(arrow);
{$ENDC}
            end;
    end;

{Background process, called on null events even when the program is switched out.}

    procedure Background;
        var
            savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(theDialog);
        EraseRect(gR);
        OffsetRect(gR, 0, 1);
        PaintRect(gR);
        if gR.top > theDialog^.portRect.bottom then
            OffsetRect(gR, 0, -theDialog^.portRect.bottom - 5);
        SetPort(savePort);
    end; {Background}

{Check if Color QuickDraw is available, with Gestalt. We assume that Gestalt is}
{available - it has been there for a LONG time now, and they say that there is glue}
{for it as well! Sadly, documentation for glue code is non-existant as far as I can tell.}

    procedure InitFlags;
        var
            feature: LongInt;
    begin
        gColorFlag := false;
        if noErr = Gestalt(gestaltQuickdrawVersion, feature) then
            gColorFlag := feature > 0; {0 = non-color QD}
    end; {InitFlags}

{Main program}

begin
    SkelInit(6, nil);                                        { Initialize                                }
    SetUpMenus;
    InitFlags;
    SetupDialog;
    SkelSetSuspendResume(@DoSuspendResume);
    SkelSetMouseMoved(@DoMouseMoved);
    SkelBackground(@Background);
    SkelSetSleep(2);

    SkelMain;                                                { loop til quit selected                }
    SkelClobber;                                            { clean up                                }
end.